perm filename ANALPA[2,LMM] blob
sn#036304 filedate 1973-04-18 generic text, type T, neo UTF8
␈↓ ↓⊗␈↓ εK
␈↓ ↓⊗ (PROGN (LISPXPRIN1 (QUOTE "FILE CREATED ")␈↓ εK (! (ANAL!PAT (CDR PATELT)
␈↓ ↓⊗ T)␈↓ εK SEGEXPR))
␈↓ ↓⊗ (LISPXPRIN1 (QUOTE "25-MAR-73 06:20:16")␈↓ εK ($$ (* Either $$ NUMBER or
␈↓ ↓⊗ T)␈↓ εK $$ EXPRESSION)
␈↓ ↓⊗ (LISPXTERPRI T))␈↓ εK (OR (NUMBERP (CDR PATELT))
␈↓ ↓⊗ (LISPXPRINT (QUOTE ANALPATVARS)␈↓ εK (AND SEGEXPR (CDR PATELT))
␈↓ ↓⊗ T)␈↓ εK (QUOTE SEG)))
␈↓ ↓⊗ (RPAQQ ANALPATVARS␈↓ εK (DEFAULT (ANALPATELT (MAKEDEFAULT PATELT)
␈↓ ↓⊗ ((FNS MAKEDEFAULT ANALPATELT ANALPAT MAXANAL MAX ANAL!PAT ␈↓ εK SEGEXPR))
␈↓ ↓⊗ TSTANAL $? SKIP$ SKIP$ANY SKIP$I ELT? MEMBPAT? ARB? ␈↓ εK [(= == ' :)
␈↓ ↓⊗ NOMATCHARB?)␈↓ εK (SETQ MATCH T) (* = FOO matches an
␈↓ ↓⊗ (VARS)))␈↓ εK element)
␈↓ ↓⊗(DEFINEQ␈↓ εK (COND
␈↓ ↓⊗␈↓ εK (SEGEXPR 1)
␈↓ ↓⊗(MAKEDEFAULT␈↓ εK (T (QUOTE ELT]
␈↓ ↓⊗ [LAMBDA (PATELT)␈↓ εK [ANY (* It's the MAX of them
␈↓ ↓⊗ (COND␈↓ εK all)
␈↓ ↓⊗ [(EQ (CAR PATELT)␈↓ εK (ANALPAT (CDR PATELT)
␈↓ ↓⊗ (QUOTE DEFAULT))␈↓ εK (AND SEGEXPR (QUOTE SEGEXPR]
␈↓ ↓⊗ (SELECTQ VARDEFAULT␈↓ εK (← (* It's a set, with the
␈↓ ↓⊗ ((←␈↓ εK same PROP as what's
␈↓ ↓⊗ SETQ SET)␈↓ εK being set)
␈↓ ↓⊗ (FRPLACA (FRPLACD PATELT (CONS (CDR PATELT)␈↓ εK (SETQ SETS T)
␈↓ ↓⊗ (QUOTE $1)))␈↓ εK (ANALPATELT (CDDR PATELT)
␈↓ ↓⊗ (QUOTE ←)))␈↓ εK SEGEXPR))
␈↓ ↓⊗ ((QUOTE ')␈↓ εK (-> (* Ditto)
␈↓ ↓⊗ (FRPLACA PATELT (QUOTE ')))␈↓ εK (SETQ SETS T)
␈↓ ↓⊗ ((= EQUAL)␈↓ εK (ANALPATELT (CDDR PATELT)
␈↓ ↓⊗ (FRPLACA PATELT (QUOTE =)))␈↓ εK SEGEXPR))
␈↓ ↓⊗ (HELP (QUOTE "FUNNY VARDEFAULT"]␈↓ εK ((!←
␈↓ ↓⊗ (T (SELECTQ VARDEFAULT␈↓ εK !->)
␈↓ ↓⊗ [(←␈↓ εK (SETQ SETS T)
␈↓ ↓⊗ SETQ SET)␈↓ εK 0)
␈↓ ↓⊗ (CONS (QUOTE ←)␈↓ εK (PROGN (* Got a PATELT which is
␈↓ ↓⊗ (CONS PATELT (QUOTE $1]␈↓ εK a list of pats)
␈↓ ↓⊗ ((QUOTE ')␈↓ εK (ANALPAT PATELT)
␈↓ ↓⊗ (CONS (QUOTE ')␈↓ εK (COND
␈↓ ↓⊗ PATELT))␈↓ εK (SEGEXPR 1)
␈↓ ↓⊗ ((= EQUAL)␈↓ εK (T (QUOTE ELT])
␈↓ ↓⊗ (CONS (QUOTE =)␈↓ εK
␈↓ ↓⊗ PATELT))␈↓ εK(ANALPAT
␈↓ ↓⊗ (HELP (QUOTE "FUNNY VARDEFAULT"])␈↓ εK [LAMBDA (PAT FLG FN TAIL)
␈↓ ↓⊗␈↓ εK
␈↓ ↓⊗␈↓ εK
␈↓ ↓⊗(ANALPATELT␈↓ εK (* Calls either ANALPATELT or FN on the elements of
␈↓ ↓⊗ [LAMBDA (PATELT SEGEXPR)␈↓ εK PAT (up to TAIL) and returns the MAXANAL of them -
␈↓ ↓⊗␈↓ εK The value of FLG determinses whether MAXANAL returns
␈↓ ↓⊗ (* Analyze PATELT , returning either -␈↓ εK a sum or a maximum)
␈↓ ↓⊗ "ELT" if PATELT matches a single element -␈↓ εK
␈↓ ↓⊗ "SEG" if PATELT matches a segment of fixed but not ␈↓ εK
␈↓ ↓⊗ given size -␈↓ εK (PROG (VAL)
␈↓ ↓⊗ A number if PATELT matches a segment of fixed, given ␈↓ εK LP (COND
␈↓ ↓⊗ size -␈↓ εK ((OR (EQ PAT TAIL)
␈↓ ↓⊗ Or "ARB" if PATELT matches a segment of not ␈↓ εK (NOT PAT))
␈↓ ↓⊗ precomputable size)␈↓ εK (RETURN VAL)))
␈↓ ↓⊗␈↓ εK (SETQ VAL (MAXANAL (APPLY* (OR FN (QUOTE ANALPATELT))
␈↓ ↓⊗␈↓ εK (CAR PAT))
␈↓ ↓⊗␈↓ εK VAL FLG))
␈↓ ↓⊗ (* Unless SEGEXPR is on, in which case, the size of ␈↓ εK (SETQ PAT (CDR PAT))
␈↓ ↓⊗ the expr is returned instead of seg)␈↓ εK (GO LP])
␈↓ ↓⊗␈↓ εK
␈↓ ↓⊗␈↓ εK(MAXANAL
␈↓ ↓⊗␈↓ εK [LAMBDA (VAL1 VAL2 FLG)
␈↓ ↓⊗ (* Also, if the PATELT is a "SET", sets special ␈↓ εK (COND
␈↓ ↓⊗ variable "SETS" -␈↓ εK ((NOT VAL1)
␈↓ ↓⊗ If it contains a match (i.e., other than $i's or $'s ␈↓ εK VAL2)
␈↓ ↓⊗ or sets involving those) it sets the special ␈↓ εK ((NOT VAL2)
␈↓ ↓⊗ variable "MATCH")␈↓ εK VAL1)
␈↓ ↓⊗␈↓ εK ((OR (EQ VAL2 (QUOTE ARB))
␈↓ ↓⊗␈↓ εK (EQ VAL1 (QUOTE ARB)))
␈↓ ↓⊗ (COND␈↓ εK (QUOTE ARB))
␈↓ ↓⊗ ((NLISTP PATELT)␈↓ εK ((OR (EQ VAL1 (QUOTE SEG))
␈↓ ↓⊗ (SELECTQ PATELT␈↓ εK (EQ VAL2 (QUOTE SEG)))
␈↓ ↓⊗ [($1 &)␈↓ εK (QUOTE SEG))
␈↓ ↓⊗ (COND␈↓ εK ((EQ FLG (QUOTE SEGEXPR))
␈↓ ↓⊗ (SEGEXPR 1)␈↓ εK ('PLUS VAL1 VAL2))
␈↓ ↓⊗ (T (QUOTE ELT]␈↓ εK (FLG (IPLUS (OR (NUMBERP VAL1)
␈↓ ↓⊗ [("*" *)␈↓ εK 1)
␈↓ ↓⊗ (SETQ SETS T)␈↓ εK (OR (NUMBERP VAL2)
␈↓ ↓⊗ (COND␈↓ εK 1)))
␈↓ ↓⊗ (SEGEXPR 1)␈↓ εK [(EQ VAL1 (QUOTE ELT))
␈↓ ↓⊗ (T (QUOTE ELT]␈↓ εK (COND
␈↓ ↓⊗ (($ --)␈↓ εK ((OR (EQ VAL2 1)
␈↓ ↓⊗ (QUOTE ARB))␈↓ εK (EQ VAL2 (QUOTE ELT)))
␈↓ ↓⊗ (HELP (QUOTE "FUNNY PAT IN ANALPATELT")␈↓ εK VAL2)
␈↓ ↓⊗ PATELT)))␈↓ εK (T (QUOTE SEG]
␈↓ ↓⊗ (T (SELECTQ (CAR PATELT)␈↓ εK [(EQ VAL2 (QUOTE ELT))
␈↓ ↓⊗␈↓ εK
␈↓ ↓⊗ (COND␈↓ εK (3) SETOK IS NIL AND A PATTERN ELMENT INVOLVING A ←
␈↓ ↓⊗ ((EQ VAL1 1)␈↓ εK IS HIT -
␈↓ ↓⊗ VAL1)␈↓ εK (4) MATCHOK IS NIL AND A PATTERN ELMENT INVOLVING A
␈↓ ↓⊗ (T (QUOTE SEG]␈↓ εK "MATCH" OF ANYKIND IS HIT -
␈↓ ↓⊗ (T (QUOTE SEG])␈↓ εK (5) THE END OF PAT IS REACHED)
␈↓ ↓⊗␈↓ εK
␈↓ ↓⊗(MAX␈↓ εK
␈↓ ↓⊗ [LAMBDA (X Y)␈↓ εK
␈↓ ↓⊗ (COND␈↓ εK (* The free variables SETS and MATCH are set to T if
␈↓ ↓⊗ ((IGREATERP X Y)␈↓ εK a set or MATCH (respectively) are found in any of
␈↓ ↓⊗ X)␈↓ εK the pattern elements passed over)
␈↓ ↓⊗ (T Y])␈↓ εK
␈↓ ↓⊗␈↓ εK
␈↓ ↓⊗(ANAL!PAT␈↓ εK (PROG (OLDSET OLDMATCH)
␈↓ ↓⊗ [LAMBDA (PAT SEGEXPR)␈↓ εK LP (SETQ OLDSET SETS)
␈↓ ↓⊗ (COND␈↓ εK (SETQ OLDMATCH MATCH)
␈↓ ↓⊗ ((NLISTP PAT)␈↓ εK [COND
␈↓ ↓⊗ (SELECTQ PAT␈↓ εK ((OR (NULL PAT)
␈↓ ↓⊗ (("*" *) (* !* is like result←$)␈↓ εK (EQ PAT TAIL))
␈↓ ↓⊗ (SETQ SETS T)␈↓ εK (RETURN PAT))
␈↓ ↓⊗ (QUOTE ARB))␈↓ εK ((OR (EQ (SETQ TEM (ANALPATELT (CAR PAT)
␈↓ ↓⊗ (($1 &) (* !$1 is the same as $)␈↓ εK T))
␈↓ ↓⊗ (QUOTE ARB))␈↓ εK (QUOTE ARB))
␈↓ ↓⊗ (HELP (QUOTE "FUNNY NLISTP PAT AFTER ! IN")␈↓ εK (AND (NOT SETOK)
␈↓ ↓⊗ PAT)))␈↓ εK SETS)
␈↓ ↓⊗ (T (SELECTQ (CAR PAT)␈↓ εK (AND (NOT MATCHOK)
␈↓ ↓⊗ (' (* !'exp matches exactly␈↓ εK MATCH))
␈↓ ↓⊗ length exp things)␈↓ εK (SETQ SETS OLDSET)
␈↓ ↓⊗ (LENGTH (CDR PAT)))␈↓ εK (SETQ MATCH OLDMATCH)
␈↓ ↓⊗ [(= ==) (* = exp matches ␈↓ εK (RETURN PAT))
␈↓ ↓⊗ precomputable NUMBER of ␈↓ εK (T (SETQ LEN ('PLUS TEM LEN]
␈↓ ↓⊗ things)␈↓ εK (SETQ PAT (CDR PAT))
␈↓ ↓⊗ (SETQ MATCH T)␈↓ εK (GO LP])
␈↓ ↓⊗ (COND␈↓ εK
␈↓ ↓⊗ [SEGEXPR (LIST (QUOTE LENGTH)␈↓ εK(SKIP$ANY
␈↓ ↓⊗ (CDR (CAR PAT]␈↓ εK [LAMBDA (PAT)
␈↓ ↓⊗ (T (QUOTE SEG]␈↓ εK
␈↓ ↓⊗ (:(QUOTE ARB))␈↓ εK (* Scans PAT until a pattern element which matches
␈↓ ↓⊗ ((←␈↓ εK an arbitrary length segment is hit)
␈↓ ↓⊗ ->)␈↓ εK
␈↓ ↓⊗ (SETQ SETS T)␈↓ εK
␈↓ ↓⊗ (ANAL!PAT (CDR PAT)))␈↓ εK
␈↓ ↓⊗ (DEFAULT (* MAKEDEFAULT actually ␈↓ εK (* The free variables SETS and MATCH are set to T if
␈↓ ↓⊗␈↓ εK
␈↓ ↓⊗ smashes it, so go ahead ␈↓ εK a set or MATCH (respectively) are found in any of
␈↓ ↓⊗ & try it again)␈↓ εK the pattern elements passed over)
␈↓ ↓⊗ (MAKEDEFAULT PAT)␈↓ εK
␈↓ ↓⊗ (ANAL!PAT PAT SEGEXPR))␈↓ εK
␈↓ ↓⊗ (ANY ␈↓ εK (PROG (OLDSET OLDMATCH TEM)
␈↓ ↓⊗␈↓ εK LP (SETQ OLDSET SETS)
␈↓ ↓⊗ (* ! (any ...) matches the MAX of ANAL!PAT of the ␈↓ εK (SETQ OLDMATCH MATCH)
␈↓ ↓⊗ elts of the any)␈↓ εK [COND
␈↓ ↓⊗␈↓ εK ((NULL PAT)
␈↓ ↓⊗␈↓ εK (RETURN PAT))
␈↓ ↓⊗ (ANALPAT (CDR PAT)␈↓ εK ((EQ (SETQ TEM (ANALPATELT (CAR PAT)
␈↓ ↓⊗ (AND SEGEXPR (QUOTE SEGEXPR))␈↓ εK T))
␈↓ ↓⊗ (FUNCTION ANAL!PAT)))␈↓ εK (QUOTE ARB))
␈↓ ↓⊗ (PROGN ␈↓ εK (SETQ SETS OLDSET)
␈↓ ↓⊗␈↓ εK (SETQ MATCH OLDMATCH)
␈↓ ↓⊗ (* Otherwise, there is a ! ␈↓ εK (RETURN PAT))
␈↓ ↓⊗ (PAT) so it's the MAX, except if there are all fixed ␈↓ εK (T (SETQ LEN ('PLUS TEM LEN]
␈↓ ↓⊗ segs, add'em up)␈↓ εK (SETQ PAT (CDR PAT))
␈↓ ↓⊗␈↓ εK (GO LP])
␈↓ ↓⊗␈↓ εK
␈↓ ↓⊗ (ANALPAT PAT (COND␈↓ εK(SKIP$I
␈↓ ↓⊗ (SEGEXPR (QUOTE SEGEXPR))␈↓ εK [LAMBDA (PAT)
␈↓ ↓⊗ (T T))␈↓ εK
␈↓ ↓⊗ NIL NIL])␈↓ εK (* Returns (and sets the variable "TAIL") to the
␈↓ ↓⊗␈↓ εK first TAIL of PAT which doesn't begin with a $i or a
␈↓ ↓⊗(TSTANAL␈↓ εK $$foo -
␈↓ ↓⊗ [LAMBDA (PAT)␈↓ εK Sets the variable "LEN" to the total length of
␈↓ ↓⊗ (PROG (SETS MATCH VA)␈↓ εK things skipped over)
␈↓ ↓⊗ (LIST (ANALPAT PAT)␈↓ εK
␈↓ ↓⊗ SETS MATCH])␈↓ εK
␈↓ ↓⊗␈↓ εK (SETQ TAIL (SOME PAT (FUNCTION (LAMBDA (ELT)
␈↓ ↓⊗($?␈↓ εK (COND
␈↓ ↓⊗ [LAMBDA (PATELT)␈↓ εK ((FMEMB ELT (QUOTE (& $1 ≠1)))
␈↓ ↓⊗ (FMEMB PATELT (QUOTE ($ ≠ --])␈↓ εK (SETQ LEN ('PLUS 1 LEN))
␈↓ ↓⊗␈↓ εK NIL)
␈↓ ↓⊗(SKIP$␈↓ εK ((EQ (CAR ELT)
␈↓ ↓⊗ [LAMBDA (PAT SETOK MATCHOK TAIL)␈↓ εK (QUOTE $$))
␈↓ ↓⊗␈↓ εK (SETQ LEN ('PLUS LEN (CDR ELT)))
␈↓ ↓⊗ (* SCANS PAT UNTIL ONE OF THE FOLLOWING CONDITIONS ␈↓ εK NIL)
␈↓ ↓⊗ OCCURS: -␈↓ εK (T])
␈↓ ↓⊗ (1) TAIL IS HIT -␈↓ εK
␈↓ ↓⊗ (2) A PATTERN ELEMENT WHICH MATCHES AN ARBITRARY ␈↓ εK(ELT?
␈↓ ↓⊗ LENGTH SEGMENT IS HIT -␈↓ εK [LAMBDA (PATELT)
␈↓ ↓⊗
␈↓ ↓⊗ (EQ (ANALPATELT PATELT)
␈↓ ↓⊗ (QUOTE ELT])
␈↓ ↓⊗
␈↓ ↓⊗(MEMBPAT?
␈↓ ↓⊗ [LAMBDA (PAT) (* Can a MEMB be used
␈↓ ↓⊗ for pat?)
␈↓ ↓⊗ (AND (FMEMB (CAAR PAT)
␈↓ ↓⊗ (QUOTE (' = ==)))
␈↓ ↓⊗ (PROG (SETS MATCH TEM3 (PAT2 (CDR PAT)))
␈↓ ↓⊗
␈↓ ↓⊗ (* Check if PAT ends is ($ 'foo nomatch nomatch ...
␈↓ ↓⊗ Arb-nomatch ...))
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗ LP (COND
␈↓ ↓⊗ ((NULL PAT2)
␈↓ ↓⊗ (RETURN))
␈↓ ↓⊗ ((AND (OR (EQ (SETQ TEM3 (ANALPATELT (CAR PAT2)))
␈↓ ↓⊗ (QUOTE ELT))
␈↓ ↓⊗ (NUMBERP TEM3))
␈↓ ↓⊗ (NULL MATCH))
␈↓ ↓⊗ (SETQ PAT2 (CDR PAT2)))
␈↓ ↓⊗ ((AND (NULL MATCH)
␈↓ ↓⊗ (EQ TEM3 (QUOTE ARB)))
␈↓ ↓⊗ (RETURN PAT2))
␈↓ ↓⊗ (T (RETURN)))
␈↓ ↓⊗ (GO LP])
␈↓ ↓⊗
␈↓ ↓⊗(ARB?
␈↓ ↓⊗ [LAMBDA (PATELT)
␈↓ ↓⊗ (EQ (ANALPATELT PATELT)
␈↓ ↓⊗ (QUOTE ARB])
␈↓ ↓⊗
␈↓ ↓⊗(NOMATCHARB?
␈↓ ↓⊗ [LAMBDA (PATELT)
␈↓ ↓⊗ (PROG (MATCH)
␈↓ ↓⊗ (AND (EQ (ANALPATELT PATELT)
␈↓ ↓⊗ (QUOTE ARB))
␈↓ ↓⊗ (NULL MATCH])
␈↓ ↓⊗)
␈↓ ↓⊗STOP
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗
␈↓ ↓⊗